home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0073_Default Boot Drive.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  19KB  |  484 lines
  1. {$A+,B-,D+,E-,F-,G-,I+,L-,N-,O-,R-,S-,T-,V-,X+}
  2. {$M 3072,0,0}
  3.  
  4. (*  A program to test some interesting behaviour of Int 21h,
  5.     function 44h subfunction 08h.....the MicroSoft documentation I
  6.     have seen indicates only that this returns an error if the flags
  7.     register is set. however, it seems that it also identifies the
  8.     default bootable logical drive, whether the machine was booted
  9.     from a floppy, and discriminates between Ram drives and normal
  10.     HDrives.....& more! Would appreciate your assistance in
  11.     running this test and returning this information to me by mail.
  12.     The results will be published in the FIDO Pascal echo.
  13.  
  14.     **************** WARNING  *****************
  15.     Although this program has run completely safely on all machines
  16.     tested by me, you should shut down or save all critical processes
  17.     before running this test.
  18.  
  19.                     L.R.A.  5/6/94                          *)
  20.  
  21. Program TestDisk;
  22.  
  23. Uses   Dos;
  24.  
  25. Const
  26.   TapeDrive    = $01;
  27.   CdRom        = $02;
  28.   Floppy       = $03;    (* Old 8 inch & ALL Floppies *)
  29.   Floppy360    = $04;    (* Also 320K Floppy *)
  30.   Floppy720    = $05;
  31.   Floppy12     = $06;
  32.   Floppy14     = $07;
  33.   Floppy28     = $08;
  34.   Floptical    = $09;
  35.   Bernoulli    = $0a;
  36.   RamDrive     = $0b;
  37.   HardDrive    = $0c;
  38.   BootHrdDrive = $0d;   (* Default HARD-Disk BootDrive !!! *)
  39.  
  40.   DriveTypes : array[0..13] of string[12] =
  41.                ('ERROR !',      'TapeDrive',    'CdRom',
  42.                 'Floppy',       '360K Floppy',  '720K Floppy',
  43.                 '1.2M Floppy',  '1.44M Floppy', '2.88M Floppy',
  44.                 'Floptical',    'Bernoulli',    'RamDrive',
  45.                 'HardDrive',    'BootHrdDrive');
  46.  
  47. Var
  48.   i           : byte;
  49.   bits        : string[16];
  50.   buff        : array [0..2047] of byte;
  51.   drive       : char;
  52.   Dtype       : byte;
  53.   f           : text;
  54.   y,m,d,dow   : word;
  55.   lastdrive   : byte;
  56.   regs        : registers;
  57.   version     : word;
  58.  
  59. (*------------------------------------------------------*)
  60. Function BinStr(num:word;bits:byte):string; assembler;
  61. ASM
  62.       PUSHF
  63.       LES  DI, @Result
  64.       XOR  CH, CH
  65.       MOV  CL, bits
  66.       MOV  ES:[DI], CL
  67.       JCXZ @@3
  68.       ADD  DI, CX
  69.       MOV  BX, num
  70.       STD
  71. @@1:  MOV  AL, BL
  72.       AND  AL, $01
  73.       OR   AL, $30
  74.       STOSB
  75.       SHR  BX, 1
  76.       LOOP @@1
  77. @@3:  POPF
  78. End;
  79.  
  80. (*------------------------------------------------------*)
  81. Function DosVersion : word;
  82. Begin
  83.   with regs do
  84.     begin
  85.       ax := $3000;
  86.       Intr($21,regs);
  87.       DosVersion := (word(al)*100)+word(ah);
  88.    end;
  89. End;
  90.  
  91. (*---------------------------------------------------------*)
  92.    (* Uses Undocumented function 52h to return actual logical
  93.       lastdrive even under Novell and even if LastDrive is not
  94.       used in Config.Sys. Must be DOS 3.1 or higher !!
  95.       Return is 1 based ie: A=1, B=2, C=3, etc. !!!!
  96.  
  97.       Note: this will always return 5 if lastdrive is not
  98.       specified in config.sys, even if less then 5 drives !                            *)
  99.  
  100. Function GetLastDrive(Var Drives:byte):boolean;
  101. Begin
  102.   With regs do
  103.     begin
  104.       ah := $52;       (* Return pointer to List of Lists *)
  105.       es := 0;
  106.       bx := 0;
  107.       Intr($21,regs);
  108.   (* This offset is ONLY valid for DOS 3.1 and above !! *)
  109.       Drives := Mem[es:bx+$21];
  110.       GetLastDrive := (Drives <> $FF)
  111.               AND ((es <> 0) AND (bx <> 0));
  112.     end;
  113. End;
  114.  
  115. (*-----------------------------------------------------------*)
  116. (* Switches to requested drive and then checks for error -
  117.    Be sure to call this with Drive UpCased !! - Should work OK
  118.    with networks ???????                                     *)
  119.  
  120. Function DriveValid(drive: char): boolean; assembler;
  121. asm
  122.     mov   ah, 19h     { Select DOS sub function 19h }
  123.     int   21h         { Call DOS for current disk drive }
  124.     mov   bl, al      { Save drive code in bl }
  125.     mov   al, Drive   { Assign requested drive to al }
  126.     sub   al, 'A'     { Adjust so A:=0, B:=1, etc. }
  127.     mov   dl, al      { Save adjusted result in dl }
  128.     mov   ah, 0eh     { Select DOS sub function 0eh }
  129.     int   21h         { Call DOS to set default drive }
  130.     mov   ah, 19h     { Select DOS sub function 19h }
  131.     int   21h         { Get current drive again }
  132.     mov   cx, 0       { Preset result to False }
  133.     cmp   al, dl      { Check if drives match }
  134.     jne   @@1         { Jump if not--drive not valid }
  135.     mov   cx, 1       { Preset result to True }
  136. @@1:
  137.     mov   dl, bl      { Restore original default drive }
  138.     mov   ah, 0eh     { Select DOS sub function 0eh }
  139.     int   21h         { Call DOS to set default drive }
  140.     xchg  ax, cx      { Return function result in ax }
  141. End;
  142. (*-----------------------------------------------------*)
  143.    (* Be sure to call this with drive UpCased ! *)
  144.  
  145. Function IsCDRom(drive : char) : boolean;
  146. Begin
  147.    with regs do
  148.      begin
  149.        ax := $150b;
  150.        bx := $0000;
  151.        cx := word(ord(drive)-65);
  152.        Intr($2f,regs);
  153.     (* If MSCDEX is loaded, bx will be $adad ! *)
  154.        IsCDRom := (ax <> 0) AND (bx = $adad);
  155.     end;
  156. End;
  157.  
  158. (*-----------------------------------------------------*)
  159.    (* Returns false if drive is local - untested !!! *)
  160.  
  161. Function DriveIsRemote(drive : char):boolean;
  162. Begin
  163.   with regs do
  164.     begin
  165.       ah := $44;
  166.       al := $09;
  167.       bl := ord(drive)-64;
  168.       Intr($21,regs);
  169.       DriveIsRemote := ((dx AND $1000) <> 0) AND (fCarry = 0);
  170.  (* Can further check if drive is substituted with
  171.                   dx AND $8000 = $8000 if so *)
  172.     end;
  173. End;
  174.  
  175. (*------------------------------------------------------*)
  176.        (* Be sure that Drive is UPCASED !
  177.     Returns FALSE on Anything that is NOT a HardDisk,
  178.     including RamDisks, CdRom, etc.                    *)
  179.  
  180. Function IsHardDisk(drive:char):boolean;
  181. Begin
  182.   with regs DO
  183.     begin
  184.       ah := $44;
  185.       al := $08;
  186.       bl := ord(drive)-64;
  187.       Intr($21, regs);
  188.       IsHardDisk := (flags AND fCarry <> fCarry)
  189.            AND (NOT (ax in [$0,$0f]));
  190.      (* ax = $0 for removable, $0f on invalid drive spec ! *)
  191.     end;
  192. End;
  193.  
  194. (*------------------------------------------------------------------*)
  195.    (* CAUTION !!!!! THIS FUNCTION IS EXPERIMENTAL !!!!!!!!!  *)
  196.  
  197.  (* Be sure that drive is UPCASED ! - This function goes to DOS
  198.     internal structures to get params for floppy type drives.
  199.     (Including Bernoulli). Because it tells DOS to rebuild the
  200.     BPB (Bios Parameter Block) for drives with removable media,
  201.     the Media Descriptor byte will always return the boot
  202.     paramaters for the drive, ie: a 1.44M floppy will always
  203.     return 1.44M, regardless of the size disk that is currently
  204.     actually in the drive !!
  205.  
  206.     A return of BootHrdDrive indicates ONLY that this is the
  207.     HardDrive with the DOS boot partition on it. It DOES NOT
  208.     indicate that the machine was booted from that drive !!!
  209.  
  210.     Dos version is MINIMUM of 3.1 !! - Check FIRST !!
  211.  
  212.     Because it does NOT read the drive, this puppy is FAST !!
  213.  
  214.     Returns these Constant types :
  215.                     ERROR !       = $00;
  216.                     TapeDrive     = $01
  217.                     CdRom         = $02;
  218. Check against this- Floppy        = $03; -to get All floppys !!
  219.                     Floppy360     = $04;
  220.                     Floppy720     = $05;
  221.                     Floppy12      = $06;
  222.                     Floppy14      = $07;
  223.                     Floppy28      = $08;
  224.                     Floptical     = $09;
  225.                     Bernoulli     = $0a;
  226.                           RamDrive      = $0b;
  227.                     HardDrive     = $0c;
  228.                     BootHrdDrive  = $0d;     *)
  229.  
  230. Function DriveType(Var f:text;drive:char):byte;
  231. Type
  232.    PtrDpbPtr = ^DpbPtr;
  233.    DpbPtr    = ^DPB;
  234.  
  235.    DPB  =  record           (* Drive Parameter Block *)
  236.      DN   : byte;      (* 0=A etc Can compare this for Subst drive *)
  237.      DDU  : byte;      (* Device Driver Unit Number *)
  238.      BPS  : word;      (* Bytes Per Sector *)
  239.      SPC  : byte;      (* Sectors Per Cluster *)
  240.      CSC  : byte;      (* Cluster Shift Count *)
  241.      BS   : word;      (* Boot Sectors *)
  242.      Fats : byte;      (* Number of fats *)
  243.      RDE  : word;      (* Max Root Dir entries *)
  244.      FDS  : word;      (* First Data Sector *)
  245.      HPC  : word;      (* Highest Possible Cluster # *)
  246.     (* Case Variant *)
  247.      Case byte of
  248.         (* DOS < 4.0 OR OS2 *)
  249.        0 : (SpfOld   : byte;   (* Sectors per fat *)
  250.             JunkOld  : array[16..22] of byte;
  251.             MdaOld   : byte;   (* Media Descriptor byte *)
  252.             DummyOld : byte;
  253.             NextOld  : DpbPtr); (* Pointer to next record *)
  254.        (* DOS >= 4.0 *)
  255.        1 :(SpfNew    : word;
  256.            JunkNew   : array[17..23] of byte;
  257.            MdaNew    : byte;
  258.            DummyNew  : byte;
  259.            NextNew   : DpbPtr);
  260.        end;
  261. Var
  262.   dnum,i,
  263.   num     : byte;
  264.   CurrDpB : DpbPtr;
  265.   MDA     : byte;
  266.   SPF     : word;
  267.   params  : array[0..31] of byte;
  268.   UseNew  : boolean;
  269.  
  270. Begin
  271.   DriveType := 0;              (* Assume failure *)
  272.   dnum := ord(drive)-64;       (* 'A'=1, 'B'=2 etc. *)
  273.   with regs do
  274.     begin
  275.       ah := $44;
  276.       al := $08;
  277.       bl := dnum;
  278.       Intr($21, regs);
  279.       if ax = $0f then exit;   (* Invalid drive ! *)
  280.  (* Here's where we try the undocumented return params ! *)
  281.       num := (ax+(flags AND fCarry)+(flags AND fParity));
  282.  
  283.    {  if (ax = 0) then        - Diversion for test purposes !
  284.         begin  }
  285.           (* OS2 will return > 10 *)
  286.           UseNew := Lo(DosVersion) in [4..9];
  287.  
  288.     (* Get Ptr to List of Lists *)
  289.           ah := $52;
  290.           es := 0;
  291.           bx := 0;
  292.           Intr($21,regs);
  293.           if (es = 0) OR (bx = 0) then exit;  (* Error ! *)
  294.  
  295.        (* Pointer to list - 0h is pointer to 1st DPB *)
  296.           CurrDpb := PtrDpbPtr(Ptr(es,bx))^;
  297.     (* Walk the chain of DPB's to our drive: 0='A' etc. *)
  298.  (* Possible that drive is SUBSTed, so index from dnum instead of DN ! *)
  299.     (* Don't index on 'A', cause it's already there ! *)
  300.           for i := 2 to dnum do
  301.             begin
  302.        (* Offset set to $ffff on last in chain *)
  303.               if (ofs(CurrDpb^) <> $ffff) then
  304.                 begin
  305.                   if UseNew then CurrDpb := CurrDpb^.NextNew
  306.                   else CurrDpb := CurrDpb^.NextOld;
  307.                 end
  308.      (* Hit end of chain before got to our drive ! *)
  309.               else exit;
  310.             end;   (* Of for *)
  311.  
  312.           Case UseNew of
  313.          (* >= DOS 4.0 and NOT OS2 *)
  314.             true  : begin
  315.                       MDA := CurrDpb^.MdaNew;
  316.                       SPF := CurrDpb^.SpfNew;
  317.                     end;
  318.           (* < DOS 4 or OS2 *)
  319.             false : begin
  320.                       MDA := CurrDpb^.MdaOld;
  321.                       SPF := CurrDpb^.SpfOld;
  322.                     end;
  323.             end;   (* Of case *)
  324.  
  325.        (* Write out buncha stuff for analysis *)
  326.           writeln(f,'DN   is : ',CurrDpb^.DN);
  327.           writeln(f,'DDU  is : ',CurrDpb^.DDU);
  328.           writeln(f,'BPS  is : ',CurrDpb^.BPS);
  329.           writeln(f,'SPC  is : ',CurrDpb^.SPC);
  330.           writeln(f,'CSC  is : ',CurrDpb^.CSC);
  331.           writeln(f,'BS   is : ',CurrDpb^.BS);
  332.           writeln(f,'FATS is : ',CurrDpb^.Fats);
  333.           writeln(f,'RDE  is : ',CurrDpb^.RDE);
  334.           writeln(f,'FDS  is : ',CurrDpb^.FDS);
  335.           writeln(f,'HPC  is : ',CurrDpb^.HPC);
  336.           writeln(f,'SPF  is : ',SPF);
  337.           writeln(f,'MDA  is : ',MDA);
  338.  
  339.     (* This work on last of multiple Benoulli drives ???? *)
  340.           if (SPF > 2) AND (MDA >= $fc) then
  341.                   DriveType := Bernoulli
  342.           else
  343.           if num = 0 then
  344.             begin
  345.     (* Tell DOS to build new BPB for removable types *)
  346.               fillchar(params,sizeof(params),0);
  347.               params[0] := 4;   (* Do NOT go to drive ! *)
  348.               ax := $440d;
  349.               cx := $0860;
  350.               bl := dnum;
  351.               dx := ofs(params);
  352.               ds := seg(params);
  353.               Intr($21, regs);
  354.               Case params[1] of
  355.                 0  : DriveType := Floppy360;
  356.                 1  : DriveType := Floppy12;
  357.                 2  : DriveType := Floppy720;
  358.                3,4 : DriveType := Floppy;
  359.                 6  : DriveType := TapeDrive;
  360.                 7  : DriveType := Floppy14;
  361.                 8  : DriveType := Floptical;
  362.                 9  : DriveType := Floppy28;
  363.                 end;
  364.                   begin
  365.                     writeln(f,'Params[1] is : ',byte(params[1]));
  366.                     writeln(f,'BPS  is : ',word(params[7]));
  367.                     writeln(f,'SPC  is : ',byte(params[9]));
  368.                     writeln(f,'Fats is : ',byte(params[12]));
  369.                     writeln(f,'RDE  is : ',word(params[13]));
  370.                     writeln(f,'SPF  is : ',word(params[18]));
  371.                     writeln(f,'MDA  is : ',byte(params[17]));
  372.                   end;
  373.             end     (* Of Not Bernoulli *)
  374.       { end}
  375.       else    (* ax > 0 ! *)
  376.         begin
  377.           Case num of
  378.             1 : DriveType := HardDrive;
  379.             5 : DriveType := BootHrdDrive;
  380.             6 : begin
  381.                   if IsCdRom(drive) then
  382.                      DriveType := CDRom
  383.                    else DriveType := RamDrive;
  384.                 end;
  385.             else DriveType := 0;            (* Error ! *)
  386.             end;  (* Of case *)
  387.         end;  (* Not a floppy or bernoulli *)
  388.     end;   (* With regs *)
  389. End;
  390.  
  391.  
  392.  
  393.  
  394. Begin      (* TestDisk *)
  395.   GetDate(y,m,d,dow);
  396.   {$I-}
  397.   assign(f,'TESTDISK.RPT');
  398.   rewrite(f);
  399.   if IoResult <> 0 then
  400.     begin
  401.       write(^G);
  402.       writeln('Can''t open report file: aborting !');
  403.       exit;
  404.     end;
  405.   SetTextBuf(f,buff);
  406.   writeln(f);
  407.   writeln(f,'DOS Drive Detection Survey Report');
  408.   writeln(f);
  409.   writeln(f,'Please mail to: CDC Micro');
  410.   writeln(f,'                PO Box 4457');
  411.   writeln(f,'                Seattle WA 98104');
  412.   writeln(f,'                (206) 435-1125');
  413.   writeln(f);
  414.   writeln(f,'Thanks for taking the time to help with this survey !');
  415.   writeln(f);
  416.   writeln(f,'Report dated : ',m:0,'/',d:0,'/',y:0);
  417.   writeln(f);
  418.   writeln(f,'Report submitted by : _________________________________________________________');
  419.   writeln(f,'My address & phone # is : _____________________________________________________');
  420.   writeln(f,'_______________________________________________________________________________');
  421.   writeln(f,'Test equipment is : ___________________________________________________________');
  422.   writeln(f,'_______________________________________________________________________________');
  423.   writeln(f,'For this test, my machine was booted from the: _______ drive.');
  424.   writeln(f,'For this test, I was running a RamDisk on Drive: ______,using _________________');
  425.   writeln(f,'For this test, I had a Bernoulli drive connected as Drive: ________ (Yes/No?)');
  426.   writeln(f,'For this test, I had a Tape/Optical drive connected as Drive: _______ (Yes/No?)');
  427.   writeln(f,'For this test, I was running Stacker/DoubleSpace/Other compressor. (Yes/No ?)');
  428.   writeln(f,'Test Conducted under : __________________________ operating/system/environment');
  429.   writeln(f,'Comments ? ____________________________________________________________________');
  430.   writeln(f);
  431.   version := DosVersion;
  432.   writeln(f,'DOS Version: ',version);
  433.   if (version < 310) OR (NOT GetLastDrive(lastdrive)) then
  434.   writeln(f,'Dos Version too low or lastdrive detection FAILED !!')
  435.   else begin
  436.   writeln(f,'LastDrive is: ',lastdrive:0);
  437.   writeln(f);
  438.   for i := 1 to lastdrive do with regs do
  439.     begin
  440.       drive := char(i+64);
  441.        if DriveValid(drive) then
  442.          begin
  443.           IsHardDisk(drive);
  444.           Dtype := ax+(flags AND fCarry)+(flags AND fParity);
  445.           bits := BinStr(flags,16);
  446.           writeln(f,'Drive '+Drive+':          Value of AX is: ',ax);
  447.           writeln('Drive '+Drive+':          Value of AX is: ',ax);
  448.           writeln(f,'Drive '+Drive+':       Value of flags is: ',flags);
  449.           writeln('Drive '+Drive+':       Value of flags is: ',flags);
  450.           writeln(f,'Drive '+Drive+':          Flags bits are: '+bits);
  451.           writeln('Drive '+Drive+':          Flags bits are: '+bits);
  452.           writeln(f,'Drive '+Drive+':      AX+carry+parity is: ',ax+(flags AND fCarry)+(flags AND fParity));
  453.           writeln('Drive '+Drive+':      AX+carry+parity is: ',Dtype);
  454.  
  455.           writeln(f,'Drive '+Drive+':     flags AND fCarry is: ',flags AND fCarry,' ',flags AND fCarry = fCarry);
  456.           writeln('Drive '+Drive+':     flags AND fCarry is: ',flags AND fCarry,' ',flags AND fCarry = fCarry);
  457.           writeln(f,'Drive '+Drive+':    flags AND fParity is: ',flags AND fParity,' ',flags AND fParity = fParity);
  458.           writeln('Drive '+Drive+':    flags AND fParity is: ',flags AND fParity,' ',flags AND fParity = fParity);
  459.           writeln(f,'Drive '+Drive+': flags AND fAuxiliary is: ',flags AND fAuxiliary,' ',flags AND fAuxiliary = fAuxiliary);
  460.           writeln('Drive '+Drive+': flags AND fAuxiliary is: ',flags AND fAuxiliary,' ',flags AND fAuxiliary = fAuxiliary);
  461.           writeln(f,'Drive '+Drive+':      flags AND fZero is: ',flags AND fZero,' ',flags AND fZero = fZero);
  462.           writeln('Drive '+Drive+':      flags AND fZero is: ',flags AND fZero,' ',flags AND fZero = fZero);
  463.           writeln(f,'Drive '+Drive+':      flags AND fSign is: ',flags AND fSign,' ',flags AND fSign = fSign);
  464.           writeln('Drive '+Drive+':      flags AND fSign is: ',flags AND fSign,' ',flags AND fSign = fSign);
  465.           writeln(f,'Drive '+Drive+':  flags AND fOverFlow is: ',flags AND fOverflow,' ',flags AND fOverFlow = fOverFlow);
  466.           writeln('Drive '+Drive+':  flags AND fOverFlow is: ',flags AND fOverflow,' ',flags AND fOverFlow = fOverFlow);
  467.  
  468.           if (Dtype > 0) then if DriveIsRemote(Drive)
  469.                 then writeln(f,'  ***** This drive is remote (network) or Substituted ?  Yes/No/Which  *****');
  470.  
  471.           writeln(f,'       *****  This is a '+DriveTypes[DriveType(f,Drive)]+' ?  Yes/No  *****');
  472.           writeln(f);
  473.           writeln;
  474.         end;    (* Drive is valid *)
  475.     end;     (* For loop *)
  476.   end;   (* Lastdrive detection *)
  477.   writeln(f,'End of Report... and Thanks for running this test !');
  478.   close(f); {$I+}
  479.   if IoResult <> 0 then;
  480.  
  481.   writeln('Please print out and mail in the TESTDISK.RPT file.');
  482.   writeln('You''ll find it in this sub-directory.');
  483.   writeln('Thanks for running this test !');
  484. End.